CORPORATION  OF  ENVIRONMENTAL  IMPACT 
ICES  INTO  N05SEMAP 


M  V  SIN  DM  A  N 

"  BEHAN EK  AND  NEWMAN  INC. 

:)  VANGWEN  STREET 

'JGA  ’’ARE,  CALIFORNIA  91303 


i 


A 


Approved  for-publie  release;  dr.  .ibution  unlimited _ 


i '« «RCK  AEROSPACE  MEDICAL  RESEAIL  LABORATORY 

JHPACE  MEDICAL  DIVISION 
FORCE  SYSTEMS  COMMAND 
I! IT-FA'ITERiSON  AIR  FORCE  BASE,  OC 


15433 


NOTICES 


!sp 


'■? 


pi-*  in 

flv  r  d 


i  im  i|"  '  il’i<p|tion«,  or  oilier  data  are  used  for  any  purpose  other  than  «  definitely  related 

oa  ni  opio  :d.!on,  dn-  Covernrin-nl  thereby  incurs  no  responsibility  nor  any  obligation  whatsoever, 
<:,wenmM-it  may  have  formulated,  furnished,  or  In  any  way  supplied  the  an  id  drawings,  a  pet  if!  ~ 
no!  tc  ho  regarded  by  implication  or  otherwise,  ns  In  any  manner  licensing  the  holder  or 
•<>r; .rid ion,  or  convoying  any  rights  or  permission  to  manufacture,  use,  or  sell  any  patented 
any  wav  be  related  thereto. 


i  rain  a:  of  this  report  from  Air  Force  Aerospace  Medical  Research  Laboratory.  Additional 

’h'liiad  !ron): 


•vmn> 

COpis 


National  Technical  Information  Service 
5?Rfj  port  Royal  Rond 
Springfield,  Virginia  221(51 

d  ageneios  and  their  contractors  registered  with  Defense  Documentation  Center  should  direct 

of  Ihi:-'  report  to: 


Defense  Documentation  Center 
Cameron  Station 
Alexandria,  Virginia  223 M 


TECHNICAL  REVIEW  AND  APPROVAL 

AFAMRL-TR-81-31 


hiiei!  reviewed  by  the  Office  of  Public  Affairs  (PA)  and  is  releasable  to  the  National  Technical 
evict:  { :iT  TS> .  At  NTIS,  it  will  be  available  to  the  general  public,  including  foreign  nations. 

d  i''  !•  has  been  reviewed  and  is  approved  for  publication. 

hi  .MAh  i!  Kit 


C  "  V\. 


v/v;nn  iWMKE 


j  ; . ;  I 


id  nee  ring  Division 

if:'hr;> I  K e mc p re h  Labor n t cry 

midp:  ; r! r; i  —  loo 


SECURITY  CLASSIFICATION  OF  THIS  PAGE  !H7ian  Data  Entered; 


REPORT  DOCUMENTATION  PAGE 


.  REPORT  NUMBER 

AFAMRL-TR-8 1-31  _ 


4.  TITLE  (*nd  Subtil to) 


READ  INSTRUCTIONS 
BEFORE  COMPLETING  FORM 


WBiEWm 


INCORPORATION  OF  ENVIRONMENTAL  IMPACT  INDICES 
INTO  NOISEMAP 


7.  AUTHOR!*; 

Harry  Seidman 


9.  PERFORMING  ORGANIZATION  NAME  AND  ADDRESS 

Bolt  Beranek  &  Newman  Inc. 

21120  Vanowen  St. 

Canoea  Park  CA  91305  _ 


It.  CONTROLLING  OFFICE  NAME  AND  ADDRESS force 

Aerospace  Medical  Research  Laboratory, 
Aerospace  Medical  Division,  Air  Force 


5.  TYPE  OF  REPORT  t  PERIOD  COVERED 

Final  Report 


6.  PERFORMING  ORG.  REPORT  NUMBER 

BBN  Prn—T~  4444 


S.  CONTRACT  OR  GRANT  NUMBER!*; 

F33615-79-C-0516 


10.  PROGRAM  ELEMENT.  PROJECT.  TASK 
AREA  4  WORK  UNIT  NUMBERS 


62202F 

7231-07-12 


1Z.  REPORT  DATE 

November  1981 


4.  MONITORING  AGENCY  NAME  4  ADDRESS!!!  dltlotent  from  Controlling  Office; 

IS.  SECURITY  CLASS,  (of  thia  report) 

ame 

Unclassified 

I5e.  OECL  ASSIFICATION /DOWNGRADING 

SCHEDULE 

IS.  DISTRIBUTION  STATEMENT  (o I  thlM  Report) 


pproved  for  public  release;  distribution  unlimited. 


17.  DISTRIBUTION  STATEMENT  (of  the  ebatrect  entered  In  Block  20,  If  different  from  Report) 


IS.  KEY  WORDS  (Continue  on  eeveree  a  Ido  If  neceaaery  and  identify  by  block  number) 

Aircraft  Noise 
Noise  Contours 
Demography 
NOISEMAP 


20.  ABSTRACT  (Continue  on  reverae  aide  If  neceaaery  end  Identity  by  block  number) 

NOISEMAP  and  the  General  Purpose  Contouring  Program  (GPCP)  were  modified  to  be 
compatible  with  the  SITE  II  demographic  data  base  and  software  program.  This 
means  that  population  and  socio-economic  status  information  from  census  tract 
tapes  can  be  routinely  obtained  for  noise  contour  areas  generated  using 
NOISEMAP.  NOISEMAP  Version  4.1  identifies  to  all  users  this  new  demographic 
overlay  capability  and  the  recent  (Feb  80)  update  of  the  military  aircraft  noise 
data  base  (NOISEFILE)  that  revised  the  algorithm  for  predicting  sound  duration 
as  a  function  of  pro 


DD  1  JAN  79  1473  EDITION  OF  1  NOV  65  IS  OBSOLETE  A 

\  SECURITY  CLASSIFICATION  OF  THIS  RAGE  (When  Date  Entered) 


PREFACE 


This  research  was  performed  for  the  Air  Force  Aerospace  Medical 
Research  Laboratory  at  Wright-Patterson  Air  Force  Base,  Ohio  under 
Project/Task  723107,  Technology  to  Define  and  Assess  Environmental 
Quality  of  Noise  From  Air  Force  Operations.  Technical  monitor  for 
this  effort  was  Mr.  Jerry  D.  Speakman  of  the  Biodynamic  Environment 
Branch,  Biodynamics  and  Bioengineering  Division.  Funding  for  this 
effort  was  provided  by  the  Air  Force  Engineering  and  Services  Center, 
Directorate  of  Environmental  Planning,  Tyndall  AFB,  Florida. 


k 


1 


t 


TABLE  OF  CONTENTS 


Pase 

INTRODUCTION  .  3 

TECHNICAL  DISCUSSION  .  4 

APPENDIX  A  -  Incorporation  of  Environmental  Impact  Indices  into 

NOI SEMAP  .  8 

APPENDIX  B  -  Computer  Program  Listings  .  10 

REFERENCES .  30 


INTRODUCTION 


The  NOISEMAP  computer  program  has  been  developed  over  the  past 
several  years  for  the  Air  Force.  This  program  calculates  the 
day-night  average  sound  levels  based  upon  aircraft  noise  and 
performance  data,  and  airport  operational  and  flight  path  information. 
AMRL-TR-78-39,  "Computer  Aided  Collection  of ^Demographic  Data  Within 
Day-Night  Level  Contours:  Two  Test  Cases,"  demonstrated  that  the 
output  from  NOISEMAP  could  be  combined  with  a  demographic  package  to 
calculate  the  population  within  each  contour.  The  purpose  of  this 
study  was  to  automate  the  process.  This  required  the  combining  of  two 
commercially  available  computer  programs  with  NOISEMAP  and  generating 
some  new  computer  programs  to  interface  these  programs. 


TECHNICAL  DISCUSSION 


In  order  to  obtain  the  demographic  data  for  a  particular  air 
base*  a  series  of  computer  programs  are  used.  First  NOISEMAP  is 
called.  NOISEMAP  was  modified  to  read  and  store  the  information 
needed  to  execute  the  demographics  package.  The  only  visible  change 
to  NOISEMAP  is  the  Version  number  4.1  and  a  new  input  card  DEMOGR. 

The  format  of  this  card  is  given  in  Figure  1. 

There  are  five  data  entries.  The  first  two  are  the  X  and  Y 
coordinates  of  a  reference  point  on  the  airbase  of  interest.  These 
are  given  in  feet  relative  to  the  grid  origin  as  are  other  locations 
used  by  NOISEMAP.  The  third  and  fourth  fields  are  the  longitude  and 
latitude  of  the  reference  point  given  in  degrees  and  fractional 
degrees.  The  fifth  entry  is  used  if  the  base  is  not  oriented  to  the 
north.  The  rotational  angle  is  given  in  degrees  and  fractional 
degrees  with  a  positive  number  implying  a  clockwise  rotation. 

The  DEMOGR  card  roust  be  preceded  by  a  PLOT  card.  NOISEMAP  will 
then  generate  two  tape  files,  TAPE8  and  TAPE11.  Both  tapes  are  used 
by  a  contouring  routine  GPCPI1  (General  Purpos^  Contouring  Program) 
developed  by  California  Computer  Products  Inc.  TAPE8  is  also  used  by 
later  routines. 

The  GPCPII  program  fits  a  surface  to  the  grid  of  data  points 
given  it  by  NOISEMAP.  After  fitting  the  surface  it  calculates  the 
locations  of  the  various  DNL  contours  specified  on  the  PLOT  card. 
GPCPII  was  modified  so  that  the  program  outputs  a  file  containing  the 
X,  Y  coordinates  of  the  points  around  each  contour.  These  values  are 
in  inches  of  pen  movement  and  must  be  scaled  before  using  them.  The 
values  are  stored  on  TAPE12  for  further  processing. 

A  new  program  named  DEMOGR  was  developed  to  serve  three  purposes. 
First,  GPCPII  puts  out  up  to  several  thousand  points  per  contour.  The 
demographics  program  SITEII  will  accept  only  150  points  per  run. 
Therefore,  the  first  task  is  to  reduce  the  number  of  points  to  less 
than  150  points.  This  is  done  by  calculating  the  slope  between  points 
and  removing  points  in  areas  where  the  slope  changes  least. 

The  second  purpose  of  DEMOGR  is  to  close  any  open  contours. 

This  is  accomplished  by  using  the  borders  of  the  grided  area  as  part 
of  the  contour.  The  final  step  is  to  reformat  the  data  into 
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Columns 

1-6 
7-1^ 
15  -  22 
23  -  30 

31  -  38 

39  -  46 


DEMOGR  Keyword 

X-coordinate  of  reference  point  (feet) 

Y-coordinate  of  reference  point  (feet) 

Latitude  of  reference  point  (degrees  and  fractional 
degrees ) 

Longitude  of  reference  point  (degrees  and  fractional 
degrees) 

Rotational  angle  of  air  base.  Positive  indicates 
clockwise  rotation  form  north  (degrees  and  frac¬ 
tional  degrees) 


Figure  1.  Format  of  Input  Card  DEMOGR 
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a  form  £hat  is  acceptable  by  the  demographics  computer  program, 
SITE11.  This  final  output  is  placed  on  TAPE2.  A  second  output  is 
put  on  TAPE40.  This  contains  information  on  the  number  of  contours 
plotted. 

A  final  computer  program  was  written,  XINDCS.  This  program 
reads  the  output  files  from  the  SITEII  program  and  TAPE40  and  prints 
out  the  population  and  number  of  households  within  each  contour.  The 
level  weighted  population  and  noise  impact  index  are  also  calculated. 

The  Level  Weighted  Population  and  Noise  Impact  Index  we 
calculate  as  defined  in  the  guidelines^developed  by  CHABA  Committee 
69  of  the  National  Academy  of  Science.  A  weighting  function  was 
developed  based  upon  social  survey  data  relating  the  fraction  of 
sampled  population  expressing  a  high  degree  of  annoyance  to  various 
values  of  day-night  average  sound  level. 

The  function  is  defined  as  follows: 


W(Ldn)  = 


[3.364  x  10-61[10°-103  Ldn-| 


C  0 . 2  j  [10°  *  03  Ldn]  +  [1>/|3  x  i0-4][io0'OS  Ldn]  > 


The  weighting  function  is  arbitrarily  normalized  to  unity  at  75 
decibels.  A  tabular  representation  is  given  in  Table  1.  Level 
weighted  populations  in  the  programs  prepared  for  the  Air  Force  are 
calculated  for  each  contour  produced. 

The  Noise  Impact  Index  is  calculated  as  follows: 


Nil 


LWP 

PT0TAL 


/P(Ldn)  *  W(Ldn)d(Ldn) 


/P(Ldn>d<Ld„>' 


Ideally  this  would  be  summed  over  all  noise  levels  for  all 
persons  exposed.  For  purposes  of  the  Air  Force  report,  this  has  been 
limited  to  a  normal  range  of  60  or  65  L.  to  85  L^  in  five  dB  steps. 
The  total  population  for  these  reports  is  assumed  ?o  be  the  total 
population  in  the  NOISEMAP  grid  area. 

Appendix  A  has  sample  outputs  from  the  SITEII  program  and  the 
XINDCS  program.  The  DEMOGR  program  output  is  designed  for  program 
testing  and  is  not  normally  printed. 

Appendix  B  contains  a  listing  of  the  two  new  computer  programs 
written. 
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TABLE  1 


SOUND  LEVEL  WEIGHTING  FUNCTION  FOR  OVERALL  IMPACT  ANALYSIS 


The  right  hand  column  is  included 

for  convenience 

for  finding  the  weighting  of  certain 

5  dB  increments. 

Ldn 

W(Ldn> 

“‘W  *  W(L, 

-db 

2 

35 

0.006 

0.010 

40 

0.013 

0.021 

45 

0.029 

0.045 

50 

0.061 

0.093 

55 

0.124 

0.180 

60 

0.235 

0.324 

65 

0.412 

0.538 

70 

0.664 

0.832 

75 

1.000 

1.214 

80 

1.428 

1.697 

85 

1.966 

2.307 

90 

2.647 
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APPENDIX  A 


INCORPORATION  OF  ENVIRONMENTAL  IMPACT 
INDICES  INTO  NOISEMAP 


DEMOGRAPHIC  DATA 


CONTOUR  VALUE  =  b5 

1978  POPULATION  =  1209? 

1978  HOUSEHOLDS  =  3759 

CONTOUR  VALUE  =  70 

1978  POPULATION  =  b339 

1978  HOUSEHOLDS  =  19?b 

CONTOUR  VALUE  -  75 

1978  POPULATION  =  9 

1978  HOUSEHOLDS  =  2 

CONTOUR  VALUE  =  80 

1978  POPULATION  =  0 

1978  HOUSEHOLDS  =  0 

TOTALS  FOR  GRIDED  AREA 
1978  POPULATION  =  19b3? 

1978  HOUSEHOLDS  9892 


LEVEL  WEIGHTED  POPULATION  =  11797 

NOISE  IMPACT  INDEX  = 


SAMPLE  XINDCS  OUTPUT 


/ 


32 

80b0 


8 


DEMOGRAPHIC  PROFILE  REPORT 


PAGE  I 


6  5DNL 

* 

*  • 

******** 

*  *  *  * 

* 

LATEST 

DEGREES 

* 

LAI 1TUDE 

42*6120 

* 

1978 

POPULATION 

12097 

LONGITUDE 

82.8330 

* 

S3 

HOUSEHOLDS 

3754 

* 

PER  CAP  INCOME 

$  4826 

3-*  POINT 

POLYGON 

* 

* 

ANNUAL  COMPOUND 

GROWTH 

****** 

CHANGE  * 
FROM  70  * 
2259  • 
1010 
$  1058 


3  »  5X 


WEIGHTING 

PCT 

100X 

* 

*  *  *  * 

*  *  * 

***** 

*  *  *  * 

*  *  *  i 

1970 

CENSUS 

DATA 

POPULATION 

AGE  AND 

SEX 

TOTAL 

9838 

100. OX 

MALE 

FEMALE 

TOTAL 

WHITE 

9258 

94.  1  X 

0-5 

69  I 

13.  4X 

658 

14.  IX 

13. 7X 

NEGRO 

544 

5. 5X 

6-13 

839 

16.2  X 

837 

18. OX 

17. OX 

OTHER 

36 

o.  AX 

14-17 

346 

6  •  7X 

305 

6.  SX 

6*  6X 

18-20 

281 

5.4X 

314 

6.7X 

6*  OX 

SPAN 

124 

1.3Z 

21-29 

1114 

21  .SX 

7  56 

16. 2X 

19. OX 

30-39 

662 

1P.8X 

610 

13.  IX 

12. 9X 

40-49 

545 

10.  5X 

474 

10. 2X 

10.  AX 

FAMILY  INCOME  <000> 

50-64 

489 

9. 5X 

484 

10. 4X 

9.9X 

SO- 5 

369 

15. 5X 

65  ♦ 

206 

4. OX 

224 

4.8X 

4.  A% 

S5-7 

287 

12. OX 

TOTAL 

5173 

4662 

S7-10 

418 

17. 5X 

MED! AN <  AGE ) 

24.  5 

23.6 

24.  1 

S 1  0  -  1  5 

688 

28. 8X 

SI  5-25 

525 

22. OX 

HOME  VALUE  <000> 

OCCUPATION 

£25-50 

77 

3  •  2  X 

SO-  10 

72 

6.PX 

MGR/PROF 

541 

20. 7X 

$  50  ♦ 

24 

1  .ox 

SIC-  1  5 

174 

15.  IX 

SALES 

208 

7  •  9X 

TOTAL 

2388 

SI  5- 20 

201 

17.4X 

CLERICAL 

470 

18. OX 

£20-25 

216 

18. 7X 

CRAFT 

493 

18.  BX 

AVERAGE 

£12042 

£25-35 

291 

25. PX 

OPERTI VS 

477 

18. 2X 

MEDIAN 

S 1 0872 

S3 5* 50 

143 

12. 4X 

LABORER 

105 

4. OX 

£50  ♦ 

57 

4.9X 

FARM 

9 

0  •  3X 

TOTAL 

1  154 

SERVICE 

301 

11  .  5t 

RENT 

PRIVATE 

13 

0.5X 

SO-  100 

590 

65.  IX 

AVERAGE 

$25429 

SI  00-1 50 

214 

23. 6X 

MEDIAN 

$23009 

SI  50-200 

74 

8.2X 

X  OWNER 

56.0 

EDUCATION 

1  ADULTS 

»  25 

S200-250 

23 

2.5X 

0-8 

890 

19. 8X 

S2  50  ♦ 

5 

0.6% 

9-11 

985 

21. 9X 

TOTAL 

906 

AUTOMOBILES 

12 

1960 

43. 5X 

NONE 

93 

3.4X 

13-15 

367 

6.2Z 

AVERAGF 

1  57 

ONE 

1  576 

57.  5X 

16  ♦ 

300 

6.7X 

MEDIAN 

S  77 

TWO 

879 

32.  IX 

X  RENTER 

44.Q 

THREE* 

191 

7. OX 

HOUSEHOLD  PARAMETERS 


FAM  POP 

8773  89. 2X 

UNITS  IN 

STRUCTURE 

HOUSEHOLDS  WITH* 

INDIVIPS 

432 

4  •  42 

1 

1  409 

51. 2X 

TV 

2569 

93. 6X 

GRP  OTRS 

633 

6*42 

2 

1  1  1 

4. OX 

WASHER 

2181 

79. 5X 

TOT  POP 

9838 

3-4 

76 

2.8X 

DRYER 

1758 

64.  1  X 

5-9 

58 

2.  IX 

DISHWSH 

536 

19. 5X 

NO  OF  HH  *  S 

2744 

10-49 

443 

1  6.  1  X 

AJRCOND 

288 

10. 5% 

NO  OF  FAM’S 

2393 

50  ♦ 

17 

0.6Z 

FREEZER 

479 

17. 5X 

AVG  HH  SIZE 

3.4 

MOBILE 

638 

23. 2X 

2  HOMES 

23 

0.8Z 

AVG  FAM  SIZE 

3.7 

CAC1# INC 


SAMPLE  SITEII  OUTPUT 
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APPENDIX  B 

COMPUTER  PROGRAM  LISTINGS 


r ■  R O O R A H  X I N n r  S  (  I N P U I  .  0 U IF1  U I  *  T AP E 5  -  I N f  ■l.l  I  y  T A p E 6-- 0 U 1  f  ■  U T 

TAPES*  TAPE 40) 


REAL  IWT 
REAL  l.WI  vNN  I 

DI  HENS  I  ON  T I  1  I..E  (  6  >  >  I  DATA  (89)  y  I  CM  Ik  (  :I00)  *  MPDP  12)  , 


:l  IWT  (12) 

DATA  TV  71978/ 

D  A 1  A  .1.  W  I  7  0  ♦  0  *  ♦  0 1 0  *  *  0  2 1  ?  •  0  4  0  y  »  0  9 .5 *  •  1 B  0  *  .  . J 2  4 
1  1  *  2 1 4  *  1  •  6  9  7  «  2  .  >  5  0  7  7 

N FILES  =  0 

DO  5  1=  1 y 1 2 
IPOP(I)  *0 
NPOP(I)  =  0 
0  CONTINUE 
10  CONI INUE 

NFIL.ES  *  NEILEBi  .1 
READ  (  40  )  I CKTR Nl  T I.  ES 
IF  (  EOF  (  40  '  ;  20  I  0 
20  CONTINUE 

N  FILES  ®  NF I  LEG  :l 

IF  (M PILES  . I...E .  100)  GO  TO  90 

WRITE ( 6*6000. i 

STOP 


READ  DATA  FROM  FILL  I  API.  8  (  ST  i  Eli  AT  j 
NEILLS  a?  N UNDER  OP  FILES 


90  CONTINUE 

WRI  TE  (  6  y  600:1  ) 

DO  1000  I  FT.  -  .1  y  NFIL.ES 

SITE  1.1  PUTS  OUT  DATA  FOR  A  RUN*  SITE  *  AND  CASE  F 
CONTOUR,  FOR  THIS  APPLICATION  ALL  3  SETS  OF  DATA 
IDENTICAL.  A  4TH  READ  IS  ISSUED  TO  BRANCH  ON  EOF 


DO  100  IC  1.  3 

READ  (8*8000)  1R UN*  I SITE*  ICASE*  TITLE.  IDaTa 
100  CONTINUE 

READ  <8 *8000 >  IDUH 
IF ( EOF < 8) )  200*201 

200  CONTINUE 

201  CONTINUE 


I F  ( I CN  F R <  I f  I  > . E 0 .  0 >  GO  TO  1 030 


I  POP 


ARP 
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W  ft  1 1 E  (  A  V  6 0  0 2 )  I C  N  r  ft  (  I  F:  L  )  y  I Y  y  I  ti  A  T  A  (  8  5  )  y  I Y 
INDEX  =  (ICNTR(IFL)  -  35)  /5  +2 
IF (INDEX  . GT ,  0>  GO  TO  300 
W  ft  I T  E  ( 6  y  6 0  0 3 )  I C  N  T  ft  ( I F  L.. ) 

INDEX  =  1 
GO  TO  400 
C 

300  CONTINUE 

IF  (INDEX  .LE.  12)  GO  TO  400 
WRITE ( 6 » 6004 )  ICNTR < IFL ) 

INDEX  =  12 
400  CONTINUE 

C 

C  STORE  DATA  IN  PROPER  REGISTER 

C 

NPOP ( I NDEX )  ~  NPOP ( I NDEX )  }  I DAT  A ( 85 ) 

L/ 

1000  CONTINUE 
1050  CONTINUE 

WRITE (6? 6005)  I Y  *  I DATA (GEO y  IYv  I  DATA (B 
NT  OT  *•  I  DATA'  85  > 

r 

C  CALCULATE  INCREMENTAL  P0PULAT1 ON 

I POP (12)  =  NPOP (12) 

DO  1100  IC  -  1 y 1 1 
ICR=  12-IC 

IF  (NPOP  (ICR)  » IT  »  NPOPdCRIl  )>  GO  TO  115 
IF' OP  ( ICR )  -  NPOP  (I  CP*  -  NPOP  (ICR  +  J  ) 
1.1.00  CONTINUE 
1150  CONTINUE 
C 
C 

C  CALCULATE  LEVEL  WEIGHTED  POPULATION 

C 

LWP  =■  0 

DO  1200  IP  -  1 y 1 2 

LWP  =  LWP  +  IWT(IP)  *  IPOP(IP) 

1200  CONTINUE 
C 

C  CALCULATE  NNI 

C 

NNI  =  LWP/  NTOT 


y  1  D  A  I  A  (  G 


C 


WRITE  (6*6006)  LUPy  NNI 
STOP 


C  ****:*..*  :i 

C  FORMATS 

C  He*.#  ♦##)}'. 

6000  FORMAT  <  38H  ***  TOO  MANY  FILES  NO  PROCESSING  #**  ) 

6001  FORMAT  <  1H1  >  10X  >  16HDEM0GRAPHI.C  DATA  ) 

6002  FORMAT  < 1H0, 10X > 16HC0NTQUR  VALUE  =  > 15  / 

1  1 IX  >  IS  >  :l  4  IT  POPULATION  -  >1:1.0  / 

2  1 1 X  >  15  >  1. 41 !  HOUSEHOLDS  •-  >110  > 

6003  FORMAT  (1H  >  I5>2X>  36H  CONTOUR  DOES  NOT  CONTRIBUTE  TO  LWF 

6004  FORMAT  (1H  >  I5»2X»  38H  CONTOUR  TREATED  AS  85  CON f OUR  IN  L 

6005  FORMAT  CL  HO » 10X > 23HT0TALS  FOR  GRIDED  AREA  / 

1  1 IX  >15  >141 1  POPULATION  ~  >110  / 

2  1 1 X  > 1 5 > 1 4H  HOUSEHOLDS  =  > I  1 0  ) 

6006  FORMAT  (////!  IX  >3011  LEVEL  WEIGHTED  POPULATION  =  >F;i.2,2// 

J  1 IX > 22H  NOISE  IMPACT  INDEX  =  >F20.4) 

C 

8000  FORMAT ( 1 1 v  213  > 6A4  > /» 1 1 <819  > / >  > 19  > 

C 

END 
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PROGRAM  DEMOOR  ( I NPUT  *  OUTPUT  *  TAPES'- 1 NPUT  r  TAPE  6  "OUTPUT  »  TAPE  .1  . 
1  TAPE 2  -  TAPE 1 2  * TAPES * TAPE 40 ) 

WRITE (6» 6100) 

A 100  FORMAT ( 1 H 1 > 

SUBROUTINE  SHORT  REDUCES  THE  NUMBER  OF  POINTS  GENERATED 
BY  OP CP  TO  LESS  THAN  150  POINTS  PER  CONTOUR 

CALL  SHORT 

SUBROUTINE  PRES2  CONVERTS  THE  DATA  GENERATED  Bt 
SHORT  INTO  A  FORMAT  READABLE  BY  THE  SITES.  I  PROGRAM 

CALL  PRESS 
REWIND  40 
STOP 
END 

SUBROUTINE  SHORT 
LOGICAL  TEND 

D I  MENS  1  ON  X  ( 1 0000  >  *  Y  (  .1. 0000  > 

I END  .FALSE . 

IOPEN  •  0 
NTEST  0 

READ < 1 2 )  /TEST » I S  v  X (  I  >  r  Y <  1  > *  1 1 
NF‘~2 

50  CONTINUE 

R  E  A  D  <  1  2 )  7.  - 1 S  :l.  *  X  ( N  P  >  *  Y(N  P  UIT  1 
I F ( NP . GT . 1 0000 )  GO  TO  900 
IF (EOF < 12) )  100*75 
75  CONTINUE 

IF  <  Z . NET . 7TEST  .OR.  I71.NE.0)  GO  TO  110 
NP=NP+  :l 
GO  TO  50 
100  CONTINUE 

I END" . TRUE . 

.1.10  CONTINUE 
NPT-NP 
NP~NP- 1 
NMAX" 149 

C A L  I.  R F D U  (  X  «  Y  »  N P  *  NMAX  ) 

:  CHECK  TO  DETERMINE  IF  OPEN  CONTOUR 


IFdT.EQ.ro  GO  TO  500 
WRIT  Ed  .»  ZTEST  *  NP  *  I  T 


WRITE ( 1  >  XU  >  >Y<  I  > 
200  CONTINUE 


2.25  CONTINUE 

IF(IENIi)  999 » 230 

230  CONTINUE 
NP=2 

XU)  =  X(NPT) 

YU)  -■  Y  (  NPT  > 

IT-IT1 

I F ( Z  .  EQ . ZTEST )  GO  TO  50 
ZTEST-Z 

IF  <  I  OPEN  <•  EQ  .  0 )  GO  10  50 
REWIND  2 

DO  300  I~1 y I OPEN 

I F  <  N  T  E  S  T  .  L  T  , 1 4  0  )  G  0  T  0  2  4 0 

XNT-~NTEST 

RATIO  “  XNT/  140. 

READ (2)  ZTvNPTTv ITT 
DO  232  K  U  *  NPT  T 
READ  (  2  )  X  ( 1.  )  .» Y  (  K  > 

232  CONTINUE 

NM AX -RATIO  *  NPTT 
C  A  L  I.  R  E  DU  (X.Y,  N  p  T  1  *  N  M  A  X  ) 
WRITE  U  )  Z'UNPI  T  .  ITT 
DO  234  K  =  J. » NPT  I 
WRITE U )  X ( K ) f Y ( I  %  » 

234  CONTINUE 
60  TO  300 
240  CONTINUE 

READ  (2)  ZT t NPTT  » ITT 
WRITE  Cl. )  ZT  f  NPTT  r  I T I 
DO  250  JCl  .NPTT 
READ  (2)  XT  t YT 
WRITE <1)  XT . YT 
250  CONTINUE 
300  CONTINUE 
NTEST-0 
TOF'EN  »  0 
REWIND  2 
GO  TO  50 


OPEN  CONTOUR 


500  continue: 

NTEST=NTE5T+NF 
IOPEN=IOPENT  1 
UR  I  TEC  2)  ZTEST  *  NF'  *  IT 
HO  A 00  1-1 *NP 

write <2>  xd)  *  vcn 

A 00  CONTINUE 
60  TO  225 
999  CONTINUE 
REWIND  I 
1000  CONTINUE 

READ ( 1 )  ZT *NF’* IT 
IF  (EOF  Cl.)  )  9999*1500 
1500  CONTINUE 

WRITE  C  AvAOOO)  ZT  *  NF' 

DO  2000  I=1,NP 
READ  < 1 )  XT  *  YT 
2000  CONTINUE 

GO  TO  1000 
900  CONTINUE 

WRITE (A* 6003)  NI¬ 
ST  OP 

9999  CONTINUE 
RETURN 

AO  00  FORMAT  Cl.  OH  CONTOUR:  *  El  0.0*  201-1  NUMBER  OF  POINT 
A 00 3  FORMAT <  1  AH  TOO  MANY  POINTS  *I10> 

END 

S  U  B  R  0 IJ  TIN  EE.  R  E  D  U  ( X » Y  *  N  P  *  N  M  A  X  ) 

D I MENS I ON  X ( 1 0000 ) *  Y ( 1 0000 ) *  XN ( 1 0000 ) *  YN ( 1 0000 > 
IF (NP.GT. 10000)  GO  TO  900 
WRITE!  <  6  *  A 000  )  NP 
IFCNP.LE.NMAX)  GO  TO  500 
TEST” .001 
25  CONTINUE 
1 1 » 1 
12*2 
I3~3 
IN-0 

X1=X< IJ  ) 

Y 1  "  Y  ( 1 1  ) 

X2=X(I2) 

Y  2  ~  Y ( 12) 

X3~X  < 13 ) 

Y3;:::Y  (13) 

50  CONTINUE 
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IFm.EQ.Y2)  GO  TO  200 
IF ( Y1 ♦ EQ ♦ Y3 )  GO  TO  200 
SI =<Xl-X2)/< Y1-Y2) 

S2  =  <X1-X3>/(Y1-Y3> 

I F <  S2 . E 0.0.)  G 0  T  0  20 0 
STEST . -  ABS(S1/S2> 

STEST =ABS ( STEST ) 

IF<  STEST. LT. TEST)  GO  TO  200 
IN-IN+l 
XN(IN)  =  XI 
YN(IN)  =  Y1 
X1=X2 
Y.t.  Y  2 
X  2  X  3 
Y2»Y3 
13=13+1 

IFCI3.GT .NP)  GO  TO  300 
X3=X( 13) 

Y3=Y < 13 ) 

GO  TO  50 
200  X2  =  X3 
Y  2  •••••  Y  3 
13=13+1 

IF (13. GT. HP)  GO  TO  300 

X3=X ( 13 > 

Y3=  Y  < 1 3  * 

GO  TO  50 

300  continue: 

XN  ( IN+3. )  =X1 
YNUN+1)  =Y1 
IN""IN+2 
X  N  ( IN)  :;"X2 
YN(IN)  =  Y2 
DO  350  I- I* IN 
X ( I ) =XN ( I ) 

Y  < I )  =YN<I> 

350  CONTINUE 
NP-IN 

IF  ( NP  .  LET. .  NMAX )  GO  TO  500 
TEST" TEST+. 001 
IF (TEST . GT ♦ 1 . >  STOP  2 

GO  TO  25 
500  continue: 

RETUF’N 
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900  CONTINUE 

WRITE  (  6  ,6001  >  NE¬ 
ST  OF 

6000  FORMAT  (28H  ORIGINAL  NUMBER  OF  POINTS  =  ,11.0 

6001  FORMAT (  1 6 II  TOO  MANY  POINTS  ,110) 

END 

SUBROUTINE  PRESS 
C 

DIMENSION  AS (2, 10) 

DIMENSION  AC',  500) 

DIMENSION  B<2, 25,10)  ,NPC.<10>  »I0RDER(10) 
DIMENSION  IDLIMF4) 

EQU I  VALENCE  ( A » B )  ,  <  X  ,  X 1. )  ,  <  Y  ,  Y 1  )  ,  (  T  M  *  Ml  > 

LOGICAL  FIRST 
LOGICAL.  LAST 
DATA  LAST/ ♦  F .  / 

DATA  D T R / 0 . 0 1 7 4  5 3 2 9 3 / 

DATA  MAXPT/I 49/ 

C 

DATA  XCMNT  /10HCMNI 
REWIND  8 
REWIND  1 
1.0  CONTINUE 

READ (8, 8000)  1 1 TEE 

8000  FORMAT (A10) 

IF  <  T I  TEE  .  EG  .  XCMNT  >  SO ,  J.  0 
50  CONTINUE 

READ <8, 8001 )  TITLE , GX »GY , GRDSE , BX , BY , BEAT , Bl  ON 

8001  FORMAT ( A 1 0 , 7F 1 0 . 0 ) 

READ  <  8 , 8002  )  ANGLE ,  SCALE  *  I  Dl ...  I M  »  NC ON 

8002  FORMAT  (  2F 1. 0.0, 5 1 1  0 ) 


CONY 

-SCALE/12. 

ANG 

“  DTR  *  ANGLE 

CA  = 

COS <  ANG ) 

SA  - 

SIN (ANG) 

ROTATE.  BASE  POINT 

BXO 

-  BX 

BYO 

BY 

X  = 

BX 

Y  - 

BY 

BX  = 

X#C.A  -  Y*SA 

BY  = 

X*SA  +  Y*CA 
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C  READ  CONTOUR  POINTS  FORM  TAPE  1 

C 

C  READ  HEADER  FIRST 

100  CONTINUE 

READ < 1 )  CONTOR * NP » I OPEN 
IF  ( EOF  (1))  900.110 

c 

C  READ  POINTS 

C 

110  CONTINUE 

IF  (I OPEN  .EG.  o  )  GO  TO  500 
DO  120  N=  1  v  NP 
READ  < 1 )  X  X  y  Y  Y 
ACL  jN)  -  XX*CONV  4  GX 
A ( 2  y  N )  -  YY*  COO ,  ■  GY 
120  CONTINUE 
C 
C 

C  FIND  POINT  WITH  LOWEST  X- VALUE 

C 

250  CONTINUE 

XMIN  =  9999999999999. 

DO  260  I- 1 yNP 

IF  <  A  ( 1 » I  >  .OF,.  XMIN)  GO  TO  260 
XMIN  =  A  (  1  y  I  ) 

IND  =  I 

260  CONTINUE 

C 

C  DETERMINE  CLOCKWISE  OR  COUNTERCLOCKWISE 

T  =  ( FLOAT (NP))  /  2. 

IT  =  IFIX(f) 

SUM  *  0. 

IP  =  IND 
IM  -  IND 

IF  (IND  .GT.  IT)  GO  TO  280 
DO  270  1-1 » IT 
IP  =  IP  »  1 
IM  =  IM  -  1 

IF  (IM  . LT .  1)  IM  =  NP 

SUM  ~  SUM  +  A ( 2 y I F ' )  -  A(2yIM> 

270  CONTINUE 
GO  TO  300 
280  CONTINUE 

DO  290  1=1 y IT 

IP  =  IP  +  1 
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IF  <  IF'  .  GT  ♦  NP)  IP  = 
in  -  in  -  I 
SUM  =  SUM  +  A <2. IP)  -  A  ( 2 » I M  > 

290  CONTINUE 

300  CONTINUE 

IF  < SUM )  320 * 320 » 310 
310  CONTINUE 
I DIR  -  1 
GO  TO  350 
320  CONTINUE 
I  DIR  -1 

C 

C  NOW  ROTATE  POINTS  AND  CONVERT  TO  DISPLACEMENT  IN  MILE 

C 

350  CONTINUE 

DO  370  I=1,NP 
X  =  A  ( 1 » I ) 

Y  =  A  <  2  y  I ) 

A  Cl.  I)  =<X*CA  ~  Y*SA  -  BX>  /  5280. 

A ( 2 . I )  ~-<X*SA  +  Y*CA  -  BY)  /  5200. 

370  CONTINUE 

r 

C 

40  0  CONTINUE 

C: 

t  READY  TO  WRITE  RESULTS  TO  OUTPUT 

C 

ICONIC  ON  TOP' 

WRITE (2. 2000)  TITLE. ICON 
WRITE ( 2 . 2001 )  TITLE. ICON » BEAT »BLON 
UR  I TE  ( 2. .  2002 )  T I TLE .  I  CON 
IF  (I DIR  .EG.  -1)  GO  TO  460 
DO  450  1=1 »NP 
X  =  All. I) 

Y  -  A  ( 2 . 1 ) 

CALL  NSEW  <  X . Y ) 

450  CONTINUE 

WRITE (40)  ICON 
ENDFILE  2 
GO  TO  100 
460  CONTINUE 

DO  490  J---1.NP 
I  =  NP  ••••  J  +  1 
X  =  A  ( 1. » I ) 

Y  =  A <2. I) 
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CALL.  NSEU  (  X » Y  ) 

490  CONTINUE 

WRITE *40)  ICON 
ENDFILEI  2 
GO  TO  100 
C 
C 

C  OPEN  CONTOUR 

C 

500  CONTINUE 

WR I TE  <  2 , 2000 )  T I TL.E » ICON 

WR I  TE  ( 2 »  200 1  )  T I TL..E * ICON  >  BEAT  ,  BLON 

WR  I  TE  (  2  *  2002 )  T I  TI  E  *  I  CON 

NL  =  0 

NIJ  =••  0 

DO  505  J=1 »500 
DO  505  I -It 2 
A  ( I  >  J  )  ~  0  . 

505  CONTINUE 

DO  506  1=1 » 10 
I ORDER (1)  =  0 
NPC(I)  =  0 

506  CONTINUE 
C 

C  READ  ALL  OPEN  SEGMENTS  FOR  THIS  CONTOUR 

C 

5  3.0  CONTINUE 

NO  =  NIJ  +  J. 

IF  (NIJ  . GT .  10)  GO  TO  990 
NL.  =  NL.  +  1 
NPC(NU)  =  NP 
N  =  0 

I T  =••  I F I X  ( FLOAT  ( NP  >  / 1 1 .  > 

N  =  Nl)  +  IT 

IF  (N  .GT.  3.0)  GO  TO  990 
DO  520  1=1 *NP 
READ  (3.)  XX  >  YY 
B ( 1 » I » NU )  =  XX*CONV  +  GX 
B(2»I»NU)  =  YY*CONV  +  GY 
520  CONTINUE 

NU  =  N 
C 

C  MUST  ALLOW  ONE  EXTRA  PLACE  AT  END  OF  EACH  SEGMENT  IN  CASE  IT  1 

C  NECESSARY  TO  ADD  A  CORNER 

C 
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IF  (MOD'Npy  1 1  )  .  NE .  0>  GD  TO  530 
NU  ~  NU  +  1 

NPC(NU)  =  0 

530  continue: 

c 

C.  READ  NEXT  HEADER 

C 

READ  ( :l.  )  XCON  1  R » NR  ?  NXOPEN 
IF  (EOF  Cl.))  550  *  540 
540  CONTINUE 

IF  ( XCONTR  . NE .  DONTOR)  GO  TO  550 
IF  (NXOPEN  ,E0.  6 )  GO  TO  550 
GO  TO  510 
C 

C  COMPUTE  THE  ORDER  OF  THE  SEGMENTS  FOR  THIS  OPEN  CONTOUR 

C 

550  CONTINUE 
NPX  -  NR 
IT  =  J 

I.  ORDER  Cl)  »  1 
ML  =  I 

WRITE (40)  ICON 
ENDFILE  2 

IF  (I OPEN  . EO .  5  )  GO  TO  500 
GO  TO  110 

c 

c 

560  continue: 

XI  =  D  (  :l  *  NPC  ( ML.  )  »  ML  ) 

Y1  =  B  ( 2  y NPC,  <  ML ) » ME  ) 

XE  =  B  ( .1. .  1  y  Ml. ) 

YE  =  B  ( 2  Cl  . » Ml. ) 

570  CONTINUE 

HIST  =  l.E+12 
DO  590  I~2 « NU 

IF  (I  . EO .  ML)  GO  TO  590 
N  =  NPC (I) 

IF  (N  .EE.  0)  GO  TO  590 
X2  -  B(lvlrl) 

Y2  ™  b ( 2 ,  i  r  :n 

DJ  «  (X1~X2>**2  +  <Y1-Y2>**2 
IF  ( III  .GE.  BIST)  GO  TO  580 

IF  (HI  .GE.  ( <XE~X2)**2+ < YE~ f 2 ) **2 ) )  GO  TO  580 
BIST  -•  DI 
IND  a  I 
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CONTINUE 
X2  -  P < 1 » N t I ) 

Y2  =  B(2»N»I) 

HI  ~  <X1-X2)**2  +  <Y1-Y2>**2 
IF  (III  .  GE .  riJST)  GO  TO  590 
IF  (HI  . GE  .  (  <XE~X2)**2KYE~Y2)**2>  >  GO  10 
Dl ST  -  III 
INI'  -I 
CONTINUE 
IT  *  II  +  J 
I ORDER (IT)  =  I NH 
IF  (IT  . EG .  NL>  GO  TO  600 
ML  =  I ADS (1 ND) 

IF  ( IND  .GT.  0)  GO  TO  560 
XI  ---  P  (  3*  lr  Ml,  ) 

Y:l  =  P  ( 2 » J. » Ml. ) 

XE  =  P  ( 1 » NPC  ( Ml.  (.ML) 
ye:  =:  P  ( 1?  i>  NPC  (  ML  >  •  ML  ) 

GO  TO  570 

THROW  OUT  EXTRA  POINTS 

CONTINUE 
NP  =  0 

DO  63  0  1  =  3.  *  NO 

NP  ~  NP  +  NPC (I) 

CONTINUE 

IF  (NP  » I...  P .  MAXPT )  GO  TO  670 
T  =  FLOAT (NP)  /  FLOAT (MAXPT) 

IT  -  IFIX(T)  +  1 
NP  =  0 

DO  650  1  =  1  r  NIJ 
J  =  I 

N  =  NPC(I) 

IF  (N  ,LF.  0)  GO  TO  650 
FIRST  =  .P. 

K  ~  1  f  IT 
CONTINUE 
J  J  +  :t 

p  a  >  j  .  :r  >  =  Bd.Kfi) 

B  ( 2 » J  r  I  >  =  P  ( 2  -LI) 

K  =  K  +  IT 

IF  (K  .  L  T .  N)  60  TO  6 20 

IF  (FIRST)  GO  TO  630 
FIRST  =  . T • 


K  *  N 
GO  TO  620 
630  continue: 

NF'C  (  I  >  =  J 
NP  NP  T  J 
650  continue 
c: 

C  DETERMINE  CLOCKWISE  OR  COUNTER  CLOCKWISE  FOR  OPEN  CONTOUR 

C  AND  CHECK  TO  SEE  IF  CORNERS  NEED  TO  BE  ADDED  AS  POLYGON  POIN 

C 

670  CONTINUE 

FIRST  =,  ,F. 

11  =  1 

I A  I  =  1 
I.  ~  2 

XI  =  B  (  :l. » NP C  <  I A 1  >  > I A 1 ) 

Y  i  =  B  ( 2  y  N  P  C  ( I A 1. )  v  I A  :l.  > 

675  CONTINUE 

12  =  I ORDER (I) 

IF  (12)  680 y 805 » 685 
680  CONTINUE 
IA2  ~  -12 

X2  -  B  ( 1  •  NPC  ( I A2  <  » I A2 ) 

Y2  -  B  (  2 »  NF’C  ( I A2  )  » I A 2  ) 

XE  -  B (  I  *  I  *  I A2  > 

YE  =  B  <  2  y  :l  *  I A2 ) 

GO  TO  690 

685  CONTINUE 
IA2  =  12 
X2  ==  B  ( 1 . 1  >  J  A 2 ) 

Y2  =  B  ( 2  v  I.  y  I A 2  > 

XE  =  B(  I  -NPCCJ  A2)  y  IA2) 

Y  E  =  B  ( 2  *  N  P  C  ( I A  2 )  y  I A  2 ) 

690  CONTINUE 

IF  (XI  --  X2 )  720  y 700 r 730 
C 

C  EQUAL  X- VALUES  -  NO  NEED  TO  ADD  A  CORNER 

700  CONTINUE 

IF  (FIRST)  GO  TO  710 
I DIR  =  1 

IF  (XI  . NE ♦  0.)  GO  TO  715 
IF  (Yl  .GT,  Y2 )  I DIR  -  -1 
FIRST  *  ,T. 

710  CONTINUE 
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II  -  12 
I A I  =  I.  A  2 
I  ~  I  +  I 
XI  =••  XE 
Y 1  ~  YE 

IF  <1  * G T .  Nt  )  GO  TO  805 
GO  TO  67 5 
C 

7 IS  CONTINUE 

IF  ( Y:l  .LI  .  Y2)  I  OIK  »  -1 
GO  TO  710 
C 

720  CONTINUE 

IF  <Y1  -  Y2)  740 » 725 r 780 
C 

C  EQUAL  Y  VALUES  ~  NO  NEEO  TO  ADD  A  CORNER 

725  CONTINUE 

IF  (FIRST)  GO  TO  710 
I  DIF:  »  l 

IF  <  Y:l  . EQ  .  0.)  1 0 I R  ••=  -  .1. 

FIRST  =  . T . 

GO  TO  7:1.0 
C 

730  CONTINUE 

IF  (Yi  -  Y2 )  790 * 735 > 800 
C 

C  EQUAL  Y  VALUES  ••••  NO  NEED  70  ADD  A  CORNER 

735  CONTINUE 

IF  (FIRST)  GO  TO  7.1.0 
ID IK  «  1 

IF  ( Y 1  . NE  ,  0.)  I. DIR  «  - 1 
FIRST  =  .7 . 

GO  TO  710 
C 

740  CONTINUE 

IF  <X1  .EQ.  0.)  GO  TO  760 
742  CONTINUE 

IF  (FIRST)  GO  TO  745 
I  MR  *  -1 
FIRST  “  , T , 

C 

C  ADD  CORNER  <X2»Yt.  >  TO  END  OF  SEGMENT  I At 

745  CONTINUE 

N  »  NEC (I At) 

N  ~  N  +  t. 
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NPC(  JA1  >  N 

IF  (II  .I  T.  0)  GO  TO  750 
L  ADD  CORNER  TO  BOTTOM  OF  LIST 

B(1»N.IA1>  =  X2 
B  (  2  >  N  •  I A 1.  )  =  Y 1 
GO  TO  710 

C  HOVE  POINTS  IN  SEGMENT  I A I  DOWN  AND  ABB  CORNER  TO  TOP  OP  I  IT.  I 

750  CQNT I NOt 

BO  755  I  “ 1  - N 
J  -  N  -  K  T  1 
B  ( 1  v  J.  IA1  '•  ™  B  ( 1 » J  ~  1 » I A  I  ) 

B  <  2  >  .1  •  I A 1 )  =  B  (  2 »  J  -■  I  ,  I A 1  ) 

755  CONTINUE 

B  ( 1  v  1  *  I A I )  ~  X  2 
B  <  2  f  ;l  y  I A  I  )  =  Y 1 
GO  TO  710 
C 

760  CONI INUE 

IF  (FIRST)  GO  TO  765 
IB. IE  *=  I 
FIRST  W  .T. 

C 

C  ABB  CORNER  (XI »Y2)  TO  ENB  F  SEGMENT  I A I 

765  CONTINUE 

N  "  NPCdAl  > 

N  =  N  +  I 
NPCdAl)  =  N 

IF  (II  * L T .  0)  GO  TO  770 
C  ADD  CORNER  TO  BOTTOM  OF  LIST 

B  ( 1  *  N  «  I A 1  )  =  XJ 
B ( 2  » N • 1 A 1 )  =  Y2 
GO  TO  710 

C  MOVE  POINTS  IN  SEGMENT  IA1  DOWN  AND  ABB  CORNER  TO  TOP  OF  L  IS  I 

770  CONTINUE 

DO  775  K  =:  1 1 N 
J  “  N  ••  K  F  1 
BCIxJdAl)  =  B(  1 » J-l  ?  IA1 ) 

B  (  2  »  J  t  I A 1  >  ~  B  ( 2 1-  J  -  I  » I A 1  ) 

775  CONTINUE 

BddvIAl)  -  XI 
B  (  2  r  1  y  I A  :l  )  «  Y2 
GO  TO  710 
C 

780  CONTINUE 

IF  (XI  .EQ.  0)  GO  TO  705 
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IF  (FIRST)  GO  TO  745 
I DIR  =  I 
FIRST  =  .T. 

GO  TO  745 

c 

785  CONTINUE 

IF  (FIRST)  GO  TO  765 

I  DIR  "•  -  I 
FIRST  •-  .T. 

GO  TO  765 
C 

790  CONTINUE 

IF  ( X2  . E 0 .  0.)  GO  TO  795 
IF  (FIRST)  GO  TO  765 
IDIR  -  -1 
FIRST  ■  » T  * 

GO  TO  765 
C 

795  continue: 

IF  (FIRST)  GO  TO  745 
IDIR  =  .1 
FIRST  ■  .T. 

GO  TO  745 

0 

800  CONTINUE 

IF  ( X  2  .  F.Q .  0.)  GO  TO  742 
GO  TO  760 

C 

805  CONTINUE 

IF  (I  .  GT .  NL.il)  GO  TO  810 
I  -  I  i  1 

12  =:  1 

GO  TO  685 
C 

C  ROTATE  POINTS  AND  CONVERT  TO  DISPLACEMENT  IN  Mil 

C 

810  CONTINUE 

CA  =  COS(ANG) 

SA  =  SIN(ANG) 

C 

C  ROTATE  BASE  POINT 

C 

BXO  =  BX 
BYO  =  BY 
X  ~  BX 
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Y  •••-  BY 

BX  =  X*CA  -  Y*SA 
BY  =  X*SA  +  Y*CA 
DO  820  I  -■  :t * NU 
N  =  NF  C  ( I  ) 

IF  ( N  .  LE.  0)  GO  TO  820 
DO  815  J=1 »N 

x  -  bci. »j.:n 

Y  ~  B  ( 2  > J  *  I ) 

815  CONTINUE: 

820  CONTINUE 
C 

DO  850  1  =  1  *  NL. 

IT  =  I ORDER C I > 

J  =  NL.  -  I  +  1 

IF  (IDIR  .EG.  -1)  IT  =  I ORDER < J )  *  (-1) 
IF  (IT  .LT.  0)  GO  TO  840 
N  =  NF'C  <  IT ) 

DO  835  J=1 * N 
X  =  B <  1  *  ...I *  IT) 

y  =  b  ( 2 .  j  » :r  r  > 

CALL  NSEU  ( X  r  Y ) 

835  CONTINUE 

GO  TO  850 
840  CONTINUE 

IT  ==  -IT 
N  =  NF’C  <  I  T  > 

DO  845  K-:l  vN 
j  ==  N  -  K  f  1 
X  -  B  <  1 » J  »  I T  ) 

Y  =  B  ( 2  » J » I T ) 

CALL  NSEU  ( X » Y ) 

845  CONTINUE 

850  CONTINUE 
860  CONTINUE 

IF  (I DIF?  .EG.  - 1 )  GO  TO  870 
X  =  B  ( 1 1 1 » 1 ) 

Y  =  B  <  2 » .1  *  1 ) 

CALL  NSEU  ( X  *  Y ) 

GO  TO  880 

870  CONTINUE 

IT-  I ORDER ( NL > 

IF  (IT  . LE .  0)  GO  TO  875 
X  =  B ( 1 » NEC ( IT ) . IT) 

Y  =  B  ( 2 » NF’C  <  IT )  r  IT ) 


I 


CALL  NSEW  <  X .  Y  ) 

GO  TO  880 
875  CONTINUE' 

IT  =  -IT 
x  -  B  <  1 » :i  » I T  > 

Y  -  B<2»1»IT ) 

CALL  NSF  W  <  X  .  Y  ) 

880  CONTINUE 

IF  < EOF ( 1 ) )  900.085 
885  CONTINUE 
NP  ~  NPX 
CON TOR  =  XCONTR 
I OPEN  =  NXOPEN 
900  CONTINUE 

IF < LAST)  950.940 
940  LAST " ♦ T . 

CONTOR  "0 ♦ 

A  (1  . 1 )  -  OX  +  ( 1 DL I M  ( 1 )  - 1 )  *  OR  DSP 

A (2. 1)  =  GY  +  ( I DL I M  <  3 ) - 1 )  *  GRDSP 

A  (1 . 2 )  ~  G X  +  ( I  Dl..  I M  <  2  >  - 1 )  *  GRDSP 

A (2. 2)  ■-  GY  +  <  IDLIM<3)~1 )  *  GRDSP 

A  (1.3)  GX  +  (IDLIM<2)-1)  *  GRDSP 

A <2. 3)  ~  GY  +  (IDL.IM(4)-1)  *  GRDSP 

A (1 . 4  )  =  GX  +  < 1 DL IN ( 1 > -1 )  *  GRDSP 

A (2. 4)  *  GY  f  ( IDLIM ( 4 ) ~ 1 )  *  GRDSP 

NP~4 

GO  TO  250 
950  CONTINUE 
RETURN 

C 

C  TOO  MANY  POINTS  IN  THIS  CONTOUR 

C 

990  CONTINUE 

WRITE  (.6,6  990)  CONTOR 

6990  FORMAT  (10X.26HTOG  MUCH  DATA  FOR  CONTOUR  »F9.0. 

1  /  5X.51HCHANGE  THE  THIRD  DIMENSION  OF  ARRAY  B  AND  TRY  AGAIN 

STOP 

5001.  FORMAT  <  A10 ) 

2000  FORMAT <  2HA  .A10.2X.I5.5H  DNL  . 5X .  J.HX . 23X .  1HX  . 25X  . 2H  ) 

2001  FORMAT ( 2HB  » A10. 2X . I5.5H  DNL  » 19X.F7. 4.3X.F8 . 4 » 18X . 1H  ) 

2002  FORMAT <2HC  .A10.2X. I5.5H  DNL  .55X.1H  ) 

END 

SUBROUTINE  NSEU  (X.Y) 

DATA  JN/ 1HN/ . JS/1HS/ . JE/1 HE/ . JW/ 1 HW/ 

r 


28 


1 


JNS  ”■  ..IN 

if  < r  . gf: .  o.)  go  to  130 

Y  ~  ABS(Y) 

JNS  ="  JS 

130  JEW  -  JF 

IF  <X  .GF.  0.)  GO  TO  150 
X  =  ABS(X) 

JEW  =  JW 
150  CONTINUE. 

WF;:  I TE  (  2  •  2000 )  JNS » Y  y  JEW  .  X 
2000  FORMAT (1 HD  *  2 1 X » A 1 y F5 . 2  y  2X  » A 1  • F5 . 2 • 45X  y 1 H  > 
RETURN 
END 
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